Floppyshop 2/Floppyshop - 2.zip/Floppyshop - 2.iso/art&graf.ix/art-3279/degaspic/degaspic.mod

Text File | 1987-04-21 | 6KB | 110 lines

MODULE Pic;  (* this creates a small desk accessory that loads a DEGAS pic
                at boot time and then shows it whenever the desk accessory
                slot is clicked on.  A click on the right mouse button will
                return the user to his normal display.  When compiling this
                with TDI's compiler, you must use GEMACCX.LNK instead of
                the normal GEMX.LNK.  The easiest way is to copy GEMACCX.LNK                from the GEMLIB folder to your main compiling directory
                and then change its name to  GEMX.LNK.  Compile and link
                as normal, making sure that your new GEMX.LNK is used.
                Change the resulting PIC.PRG to a file with an ACC extender,                such as PIC.ACC,  and it should work fine. *)

FROM SYSTEM IMPORT ADDRESS, ADR;

IMPORT AESApplications, AESWindows, AESEvents, AESGraphics, XBIOS, GEMDOS,
       AESMenus, AESForms;

FROM XBIOS IMPORT GetResolution;


VAR
        apid           : INTEGER;
        accNumber      : INTEGER;
        FreeRam        : ADDRESS;
        pic            : ADDRESS;   (* address of our picture screen *)
        count          : LONGCARD;
        OK             : BOOLEAN;     (* true if a picture was loaded *)
        handle         : INTEGER;
        orgPalette     : XBIOS.Palette;  (* 0..15 of cardinal *)
        newPalette     : POINTER TO XBIOS.Palette;  (* same thing *)
        PictureName    : ARRAY[0..6] OF CHAR;  (*  picture name *)


PROCEDURE Event;
          (*  this is the main loop that waits for our desk accessory
              slot to be clicked on.  If a picture was loaded it will
              be shown, after the present palette is saved.  Then when
              the right button is clicked the old palette will be
              restored and the screen switched back to show the old data.
              If no picture was loaded, then an alert box is shown.
              The user can release the picture buffer for his own use if
              he clicks the right button when the mouse is in the extreme
              upper left corner of the screen  Users should do this before
              they change resolutions because a new buffer will be loaded
              in anyway. The mouse X and Y coords are returned in the
              button message *)

VAR
        physScreen      : ADDRESS;
        logScreen       : ADDRESS;
        result          : INTEGER;
        x,y,button,key  : INTEGER;
        msg             : ARRAY[0..15] OF CARDINAL;

BEGIN
        REPEAT
           AESEvents.EventMessage(ADR(msg));
           IF msg[0] = 40 THEN   (* if our accessory selected *)
             IF  OK THEN         (* if pic found *)
              physScreen := XBIOS.ScreenPhysicalBase(); (* get phys screen *)              logScreen := XBIOS.ScreenLogicalBase();  (* get log screen *)
              FOR result := 0 TO 15 DO   (* save palette for restoring *)
                 orgPalette[result] := XBIOS.SetColour(result,newPalette^[result]);        END;  (* FOR *)
              AESGraphics.GrafMouse(256,NIL);  (* turn mouse off *)
              XBIOS.SetScreenBase(pic,pic,-1);  (* switch to pic screen *)
              AESWindows.WindowUpdate(3);       (* grab control from AES *)
              (* wait for a button click and then restore old screen *)
              result := AESEvents.EventButton(1,2,2,x,y,button,key);
              AESWindows.WindowUpdate(2);       (* give AES mouse control *)
              XBIOS.SetPalette(orgPalette);  (* restore old palette *)
              XBIOS.SetScreenBase(physScreen,logScreen,-1);  (* restore *)
              IF (x = 0) AND (y = 0) THEN (* upper left corner. free ram *)
                 IF GEMDOS.Free(FreeRam) THEN END; (* release RAM *)
                 OK := FALSE;  (* no more pic since RAM released *)
              END;  (* if user decided to release RAM *)
              AESGraphics.GrafMouse(257,NIL);     (* turn mouse on *)
           ELSE result := AESForms.FormAlert(1,'[3][ Sorry, but no picture to show. ][ OK ]');
          END;  (* IF OK *)
        END;  (* if acc open *)
        UNTIL FALSE;
END Event;

BEGIN
        (* this does the normal GEM initialization and then allocates
           RAM for a buffer to store the picture in. The ST's resolution
           is checked and then the proper DEGAS extender is used to load
           the first picture in the current directory with the proper
           DEGAS extender.  IF no picture is loaded, OK is set to FALSE
           and the RAM is released.  After this is taken care of, the
           Event procedure performs an endless loop waiting for the
           accessory slot to be clicked on *)

        apid := AESApplications.ApplInitialise();  (* get an ID *)
        accNumber := AESMenus.MenuRegister(apid,"  Show Picture");
             (* we just grabbed acc slot and set name to "Show Picture" *)
        GEMDOS.Alloc(32290,FreeRam);         (* grab picture buffer *)
        pic := FreeRam + (256 - (FreeRam MOD 256));
                       (* now we are on a 256 byte boundry, as needed *)
        newPalette := pic -32; (* address of palette *)
        PictureName := "*.piX";  (* we will set "X" in extender for res *)
        (* now get resolution (0,1,2) add 49 to get ASCII chr for res *)
        PictureName[4] := CHR(GetResolution()+49);  (* PI1, PI2, or PI3 *)
        GEMDOS.Open(PictureName,0,handle);
        IF handle > 5 THEN (* pic found *)
           count := 32034;
           GEMDOS.Read(handle,count,(pic-34));
           OK := GEMDOS.Close(handle);
        ELSE
           OK := FALSE; (* couldn't load picture so *)
           IF GEMDOS.Free(FreeRam) THEN END;(* free up memory *)
        END; (* IF *)
        Event;
END Pic.